home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / e / amigae30a_fr.lha / AmigaE30f / Sources / Lang / NGRC.e < prev   
Encoding:
Text File  |  1994-02-21  |  15.7 KB  |  549 lines
  1. /* Noise Compiler v1.0       */
  2. /* Compilateur de NoiseTracker v1.0 */
  3. /* TraductionOlivier ANH (BUGSS) */
  4.  
  5. OBJECT sym              /* structure primaire de symboles de réécriture */
  6.   next,type,name,rptr
  7. ENDOBJECT
  8.  
  9. OBJECT rlist            /* structure de liste liée pour la grammaire */
  10.  
  11.   next,type,index,info
  12. ENDOBJECT
  13.  
  14. OBJECT optset           /* structure pour stocker { | | } */
  15.   next,rptr,weight
  16. ENDOBJECT
  17.  
  18. OBJECT sample           /* toutes les données à propos d'un sample */
  19.   path,len,adr,vol
  20. ENDOBJECT
  21.  
  22. OBJECT i                /* indexation des arbres réécrit */
  23.   start,len,isym
  24. ENDOBJECT
  25.  
  26. ENUM SYM,OPTSET,OPTION,NOTE,SAMPLE,SFX          /* rlist.type   */
  27. ENUM NOTYPE,REWRITE                             /* sym.type     */
  28. ENUM NOMEM,NOFILE,NOFORM,NOGRAM,STACKFLOW,      /* erreurs      */
  29.      BADSTRUCTURE,BREAK,WRITEMOD,READSAMPLE
  30.  
  31. CONST MAXINDEX=1000,MAXROWS=64*4*64,MAXDURATION=100
  32. CONST MAXDATA=MAXROWS*4,MAXSAMPLE=31,MAXNOTE=23,MINNOTE=-12
  33. CONST PARSE_ER=100,GEN_ER=200,MASK=$0FFF0FFF
  34.  
  35. RAISE NOMEM IF New()=NIL,                       /* définie les exceptions */
  36.       NOMEM IF String()=NIL,
  37.       STACKFLOW IF FreeStack()<1000,
  38.       BREAK IF CtrlC()=TRUE
  39.  
  40. DEF buf,flen,p,tokeninfo,symlist=NIL:PTR TO sym,ltoken=-1,numsample=0,
  41.     notes,np:PTR TO LONG,maxrows=0,cursample=0,cursfx=0,curglob=0,end,
  42.     timings:PTR TO INT,fh=NIL,notevals:PTR TO LONG
  43.  
  44. DEF sdata[32]:ARRAY OF sample,
  45.     itab[MAXINDEX]:ARRAY OF i,
  46.     channel[4]:ARRAY OF i,
  47.     infile[100]:STRING,outfile[100]:STRING
  48.  
  49. PROC main() HANDLE
  50.   WriteF('Noise Compiler v1.0\n')
  51.   WriteF('Traduit les fichiers compatible Noise en module ProTracker !\n')
  52.   readgrammar()
  53.   WriteF('Grammaire "\s" chargée. Analyse...\n',infile)
  54.   parsegrammar()
  55.   WriteF('Grammaire analysée avec succès. Génération...\n')
  56.   generate()
  57.   WriteF('Noise généré. Chargement des samples...\n')
  58.   loadsamples()
  59.   WriteF('Sauvegarde du fichier "\s".\n',outfile)
  60.   writemodule()
  61.   WriteF('done.\n')
  62. EXCEPT
  63.   IF fh THEN Close(fh)           /* Handlers des exceptions les plus basses */
  64.   WriteF('Programme terminé: ')  /* report des grosses erreurs*/
  65.   SELECT exception
  66.     CASE NOFILE;       WriteF('Ne peut charger le fichier grammaire "\s" !\n',infile)
  67.     CASE NOMEM;        WriteF('Pas assez de mémoire !\n')
  68.     CASE NOFORM;       WriteF('Érreur du format grammaticale !\n')
  69.     CASE STACKFLOW;    WriteF('Dépacement de la pile ! (récursion trop profonde ?)\n')
  70.     CASE BADSTRUCTURE; WriteF('Problème à la génération.\n')
  71.     CASE NOGRAM;       WriteF('Pas de rêgle réécrite!\n')
  72.     CASE BREAK;        WriteF('Stoppé par l''utilisateur\n')
  73.     CASE WRITEMOD;     WriteF('Impossible d''écrire le module PT "\s" !\n',outfile)
  74.     CASE READSAMPLE;   WriteF('Impossible de lire les sample(s) !\n')
  75.   ENDSELECT
  76. ENDPROC
  77.  
  78. PROC readgrammar()
  79.   StrCopy(infile,arg,ALL)
  80.   StrAdd(infile,'.ngr',ALL)     /* '#?.ngr' = NoizGRammar */
  81.   StrCopy(outfile,arg,ALL)      /* '#?.mod' = format ProTracker */
  82.   StrAdd(outfile,'.mod',ALL)
  83.   IF (flen:=FileLength(infile))<1 THEN Raise(NOFILE)
  84.   IF (fh:=Open(infile,OLDFILE))=NIL THEN Raise(NOFILE)
  85.   IF Read(fh,buf:=New(flen+1),flen)<>flen THEN Raise(NOFILE)
  86.   Close(fh)
  87.   fh:=NIL
  88.   buf[flen]:=";"        /* pour analyser */
  89. ENDPROC
  90.  
  91. /* c'est la partie analyse. on utilise une simple mais puissante analyse de
  92.    haut en bas et construit notre arbre syntaxique ici.  */
  93.  
  94. ENUM ER_UNTOKEN=PARSE_ER,ER_UNEXPECTED,ER_QUOTE,ER_SYMEXP,ER_DOUBLE,
  95.      ER_ARROWEXP,ER_RPARENTHEXP,ER_RBRACEEXP,ER_EMPTY,ER_EOLEXP,ER_RANGE,
  96.      ER_COMMENT,ER_UNDEF,ER_RBRACKETEXP,ER_MAXSAMPLE,ER_NOSAMPLE,
  97.      ER_INTEGEREXP,ER_COMMAEXP,ER_NOTEEXP
  98.  
  99. ENUM EOF,EOL,ARROW,BAR,COMMA,           /* ; -> | ,     */
  100.      RSYM,INTEGER,HEXINTEGER,           /* sym 100 $E01 */
  101.      ISTRING,NOTEVAL,                   /* "" C#+       */
  102.      LBRACE,RBRACE,LPARENTH,            /* { } (        */
  103.      RPARENTH,LBRACKET,RBRACKET         /* ) [ ]        */
  104.  
  105. PROC parsegrammar() HANDLE
  106.   DEF end,spot,sl:PTR TO sym,s,i
  107.   notevals:=[9,11,0,2,4,5,7]
  108.   p:=buf
  109.   WHILE parserule() DO NOP
  110.   p:=NIL
  111.   IF (sl:=symlist)=NIL THEN Raise(NOGRAM)
  112.   IF numsample=0 THEN Raise(ER_NOSAMPLE)
  113.   REPEAT
  114.     IF sl.type=NOTYPE            /* vérifie si symboles indéfinis */
  115.       s:=sl.name
  116.       Raise(ER_UNDEF)
  117.     ENDIF
  118.   UNTIL (sl:=sl.next)=NIL
  119. EXCEPT                         /* re-saute si exception inconnue*/
  120.   IF exception>=PARSE_ER THEN WriteF('ERROR: ') ELSE Raise(exception)
  121.   WriteF(ListItem(['Contenu léxical en faute\n',
  122.     'Mauvais caractères en ligne !\n',
  123.     'Nombre impaire d''apostrophes"\n',
  124.     'Manque un symbole\n',
  125.     'Double définition d''un symbole\n',           /* érreurs langage */
  126.     'Manque "->"\n',
  127.     'Manque ")"\n',
  128.     'Manque "}"\n',
  129.     'Liste de réécriture vide\n',
  130.     'Manque la fin des règles (End of rule)\n',
  131.     'Valeur Entière/Note hors norme\n',
  132.     'Commentaire(s) incorrect(s)\n',
  133.     'Pas de règle définie pour le symbole "\s"\n',
  134.     'Manque "]"\n',
  135.     'Plus de 32 samples\n',
  136.     'Grammaire a besoin d'au moins un sample\n',
  137.     'Manque un entier\n',
  138.     'Manque ","\n',
  139.     'Manque une note'],exception-PARSE_ER),s)
  140.   IF p                /* affiche une indication utile des érreurs*/
  141.     IF p[-1]=";" THEN DEC p
  142.     spot:=p
  143.     WHILE (p[]--<>";") AND (p[]<>10) AND (p<>buf) DO NOP
  144.     INC p
  145.     spot:=spot-p+5
  146.     end:=p
  147.     WHILE (end[]<>";") AND (end[]++<>10) DO NOP
  148.     end[]--:=0
  149.     WriteF('LINE: \s\n',p)
  150.     FOR i:=1 TO spot DO WriteF(' ')
  151.     WriteF('^\n')
  152.   ENDIF
  153.   Raise(NOFORM)
  154. ENDPROC
  155.  
  156. PROC parserule()
  157.   DEF token,csym:PTR TO sym
  158.   IF (token:=gettoken())=EOF
  159.     RETURN FALSE
  160.   ELSEIF token=RSYM
  161.     csym:=tokeninfo
  162.     IF csym.type<>NOTYPE THEN Raise(ER_DOUBLE)
  163.     IF gettoken()<>ARROW THEN Raise(ER_ARROWEXP)
  164.     csym.rptr:=parseitemlist()
  165.     csym.type:=REWRITE
  166.     IF gettoken()<>EOL THEN Raise(ER_EOLEXP)
  167.   ELSE
  168.     Raise(ER_SYMEXP)
  169.   ENDIF
  170. ENDPROC TRUE
  171.  
  172. PROC parseitemlist()
  173.   DEF item:PTR TO rlist,prev:PTR TO rlist,ilist=NIL
  174.   prev:={ilist}
  175.   WHILE (item:=parseitem())<>NIL
  176.     prev.next:=item
  177.     prev:=item
  178.   ENDWHILE
  179.   IF ilist=NIL THEN Raise(ER_EMPTY)
  180. ENDPROC ilist
  181.  
  182. PROC parseitem()
  183.   DEF token,item:PTR TO rlist,t2,prev:PTR TO optset,
  184.       curr:PTR TO optset,olist,totalw=0
  185.   token:=gettoken()
  186.   IF token=RSYM
  187.     item:=New(SIZEOF rlist)
  188.     item.type:=SYM
  189.     item.info:=tokeninfo
  190.     IF (t2:=gettoken())=INTEGER
  191.       item.index:=checkinfo(1,MAXINDEX-1)
  192.     ELSE
  193.       putback(t2)
  194.       item.index=0
  195.     ENDIF
  196.   ELSEIF token=ISTRING
  197.     item:=New(SIZEOF rlist)
  198.     item.type:=SAMPLE
  199.     sdata[numsample].path:=tokeninfo
  200.     IF (t2:=gettoken())=INTEGER
  201.       sdata[numsample].vol:=checkinfo(0,64)
  202.     ELSE
  203.       putback(t2)
  204.       sdata[numsample].vol:=64
  205.     ENDIF
  206.     item.info:=numsample++
  207.     IF numsample=MAXSAMPLE THEN Raise(ER_MAXSAMPLE)
  208.   ELSEIF token=LBRACE          /* analyse { | | ... } */
  209.     item:=New(SIZEOF rlist)
  210.     item.type:=OPTSET
  211.     prev:={olist}
  212.     REPEAT
  213.       curr:=New(SIZEOF optset)
  214.       IF (token:=gettoken())=INTEGER        /* vérifie la largeur */
  215.         curr.weight:=checkinfo(0,1000)
  216.       ELSE
  217.         curr.weight:=1
  218.         putback(token)
  219.       ENDIF
  220.       totalw:=totalw+curr.weight
  221.       curr.rptr:=parseitemlist()
  222.       prev.next:=curr
  223.       prev:=curr
  224.     UNTIL (token:=gettoken())<>BAR
  225.     IF token<>RBRACE THEN Raise(ER_RBRACEEXP)
  226.     item.info:=olist
  227.     item.index:=totalw     /* on stocke la largeur ici */
  228.   ELSEIF token=LPARENTH
  229.     item:=New(SIZEOF rlist)             /* analyse ( ) */
  230.     item.type:=OPTION
  231.     IF (token:=gettoken())=INTEGER        /* vérifie la largeur */
  232.       item.index:=checkinfo(0,1000)
  233.     ELSE
  234.       item.index:=500
  235.       putback(token)
  236.     ENDIF
  237.     item.info:=parseitemlist()
  238.     IF gettoken()<>RPARENTH THEN Raise(ER_RPARENTHEXP)
  239.   ELSEIF token=LBRACKET
  240.     item:=New(SIZEOF rlist)             /* analyse [note,durée] */
  241.     item.type:=NOTE
  242.     token:=gettoken()
  243.     IF (token<>INTEGER) AND (token<>NOTEVAL) THEN Raise(ER_NOTEEXP)
  244.     item.info:=checkinfo(MINNOTE,MAXNOTE)
  245.     IF gettoken()<>COMMA THEN Raise(ER_COMMAEXP)
  246.     IF gettoken()<>INTEGER THEN Raise(ER_INTEGEREXP)
  247.     item.index:=checkinfo(1,MAXDURATION)
  248.     IF gettoken()<>RBRACKET THEN Raise(ER_RBRACKETEXP)
  249.   ELSEIF token=HEXINTEGER
  250.     item:=New(SIZEOF rlist)             /* analyse $SFX */
  251.     item.type:=SFX
  252.     item.info:=checkinfo(0,$FFF)
  253.   ELSEIF (token=EOL) OR (token=RBRACE) OR (token=RPARENTH) OR (token=BAR)
  254.     putback(token)
  255.     RETURN NIL
  256.   ELSE
  257.     Raise(ER_UNTOKEN)
  258.   ENDIF
  259. ENDPROC item
  260.  
  261. /* l'analyseur léxical : appelé par l'analyseur chaque fois qu'il a besoin
  262.    d'un token. Les valeurs attribue sont dans "tokeninfos".
  263.    allows for one symbol lookahead, with putback() function */
  264.  
  265. PROC gettoken()
  266.   DEF c,x,start,len,syml:PTR TO sym,s,depth
  267.   FreeStack(); CtrlC()
  268.   IF ltoken<>-1
  269.     x:=ltoken
  270.     ltoken:=-1
  271.     RETURN x
  272.   ENDIF
  273.   tokeninfo:=0
  274.   parse:
  275.   c:=p[]++
  276.   SELECT c
  277.     CASE ";"; RETURN IF buf+flen<p THEN p-- BUT EOF ELSE EOL
  278.     CASE "|"; RETURN BAR
  279.     CASE ","; RETURN COMMA
  280.     CASE "("; RETURN LPARENTH
  281.     CASE ")"; RETURN RPARENTH
  282.     CASE "{"; RETURN LBRACE
  283.     CASE "}"; RETURN RBRACE
  284.     CASE "["; RETURN LBRACKET
  285.     CASE "]"; RETURN RBRACKET
  286.     CASE "-"; IF p[]=">" THEN RETURN p++ BUT ARROW
  287.     CASE "/"
  288.       IF p[]="*"
  289.         x:=p
  290.         depth:=1
  291.         WHILE buf+flen>p++
  292.           IF (p[0]="/") AND (p[1]="*")
  293.             INC depth
  294.             INC p
  295.           ENDIF
  296.           IF (p[0]="*") AND (p[1]="/")
  297.             DEC depth
  298.             INC p
  299.           ENDIF
  300.           IF depth=0
  301.             INC p
  302.             BRA parse
  303.           ENDIF
  304.         ENDWHILE
  305.         p:=x
  306.         Raise(ER_COMMENT)
  307.       ENDIF
  308.       Raise(ER_UNEXPECTED)
  309.     CASE 34
  310.       start:=p
  311.       WHILE (p[]<>";") AND (p[]<>10) AND (p[]++<>34) DO NOP
  312.       IF p[-1]=";" THEN p-- BUT Raise(ER_QUOTE)
  313.       len:=p-start-1
  314.       tokeninfo:=String(len)
  315.       StrCopy(tokeninfo,start,len)
  316.       RETURN ISTRING
  317.     DEFAULT
  318.       IF (c>="a") AND (c<="z")
  319.         start:=p--
  320.         WHILE (p[]>="a") AND (p[]++<="z") DO NOP
  321.         len:=p---start
  322.         s:=String(len)
  323.         StrCopy(s,start,len)
  324.         syml:=symlist
  325.         WHILE syml
  326.           IF StrCmp(s,syml.name,ALL) THEN BRA found
  327.           syml:=syml.next
  328.         ENDWHILE
  329.         syml:=New(SIZEOF sym)
  330.         syml.next:=symlist
  331.         syml.name:=s
  332.         syml.type:=NOTYPE
  333.         symlist:=tokeninfo:=syml
  334.         RETURN RSYM
  335.         found:
  336.         tokeninfo:=syml
  337.         RETURN RSYM
  338.       ELSEIF (c>="A") AND (c<="G")
  339.         tokeninfo:=notevals[c-"A"]
  340.         LOOP
  341.           x:=p[]++
  342.           SELECT x
  343.             CASE "+"; tokeninfo:=tokeninfo+12           /* octave sup   */
  344.             CASE "-"; tokeninfo:=tokeninfo-12           /* octave inf   */
  345.             CASE "#"; tokeninfo:=tokeninfo+1            /* piqué        */
  346.             CASE "b"; tokeninfo:=tokeninfo-1            /* plat         */
  347.             DEFAULT
  348.               DEC p
  349.               RETURN NOTEVAL
  350.           ENDSELECT
  351.         ENDLOOP
  352.       ELSEIF ((c>="0") AND (c<="9")) OR (c="-") OR (c="$")
  353.         tokeninfo:=Val(p--,{x})
  354.         p:=p+x
  355.         RETURN IF c="$" THEN HEXINTEGER ELSE INTEGER
  356.       ENDIF
  357.       IF c>32 THEN Raise(ER_UNEXPECTED) ELSE BRA parse
  358.   ENDSELECT
  359. ENDPROC
  360.  
  361. PROC putback(token)
  362.   ltoken:=token
  363. ENDPROC
  364.  
  365. PROC checkinfo(min,max) RETURN IF (tokeninfo<min) OR (tokeninfo>max) THEN
  366.   Raise(ER_RANGE) ELSE tokeninfo
  367.  
  368. ENUM NOCHANNEL=GEN_ER,LARGESONG,CROSSINDEX
  369.  
  370. PROC generate() HANDLE
  371.   DEF x,ci:PTR TO i,syms:PTR TO LONG,numc=0
  372.   Rnd(-Shl(VbeamPos(),14))        /* initialise seed */
  373.   ci:=itab
  374.   FOR x:=0 TO MAXINDEX-1 DO ci[].start++:=NIL
  375.   ci:=channel
  376.   timings:=[856,808,762,720,678,640,604,570,538,508,480,453,
  377.             428,404,381,360,339,320,302,285,269,254,240,226,
  378.             214,202,190,180,170,160,151,143,135,127,120,113]:INT
  379.   /*        C-  C#- D-  D#- E-  F-  F#- G-  G#- A-  A#- B-
  380.             C   C#  D   D#  E   F   F#  G   G#  A   A#  B
  381.             C+  C#+ D+  D#+ E+  F+  F#+ G+  G#+ A+  A#+ B+     */
  382.   np:=notes:=New(MAXDURATION*4+100+MAXDATA)
  383.   end:=np+MAXDATA
  384.   syms:=['one','two','three','four']
  385.   FOR x:=0 TO 3
  386.     ci[x].start:=np
  387.     IF findsym(syms[x])
  388.       ci[x].len:=np-ci[x].start
  389.       IF ci[x].len>maxrows THEN maxrows:=ci[x].len
  390.       INC numc
  391.     ELSE
  392.       ci[x].start:=NIL
  393.     ENDIF
  394.   ENDFOR
  395.   IF numc=0 THEN Raise(NOCHANNEL)
  396.   IF maxrows=0 THEN Raise(NOGRAM)
  397.   IF maxrows>MAXROWS THEN Raise(LARGESONG)
  398. EXCEPT
  399.   IF exception>=GEN_ER THEN WriteF('ERROR: ')
  400.   SELECT exception
  401.     CASE NOCHANNEL;  WriteF('Un canal doit être au moins défini\n')
  402.     CASE LARGESONG;  WriteF('Song trop grand !\n')
  403.     CASE CROSSINDEX; WriteF('Pas d'indéxation permise cross-symbol\n')
  404.     DEFAULT;         Raise(exception)         /* re-saute si inconnu */
  405.   ENDSELECT
  406.   Raise(BADSTRUCTURE)        /* termine */
  407. ENDPROC
  408.  
  409. PROC findsym(name)
  410.   DEF s:PTR TO sym
  411.   s:=symlist
  412.   WHILE s
  413.     IF StrCmp(s.name,name,ALL) THEN BRA.S continue
  414.     s:=s.next
  415.   ENDWHILE
  416.   RETURN FALSE
  417.   continue:
  418.   rewritelist(s.rptr)
  419. ENDPROC TRUE
  420.  
  421. PROC rewritelist(list:PTR TO rlist)
  422.   WHILE list
  423.     rewritesym(list)
  424.     list:=list.next
  425.   ENDWHILE
  426. ENDPROC
  427.  
  428. PROC rewritesym(rsym:PTR TO rlist)
  429.   DEF t,sl:PTR TO sym,rnd,c1,c2,ol:PTR TO optset,x,i,st:PTR TO LONG,l,n
  430.   FreeStack(); CtrlC()
  431.   t:=rsym.type
  432.   SELECT t
  433.     CASE SYM
  434.       sl:=rsym.info
  435.       IF i:=rsym.index
  436.         st:=itab[i].start
  437.         l:=itab[i].len
  438.         IF st
  439.           IF np+l>=end THEN Raise(LARGESONG)
  440.           IF sl<>itab[i].isym THEN Raise(CROSSINDEX)
  441.           l:=Shr(l,2)
  442.           IF l THEN FOR x:=1 TO l DO np[]++:=IF n:=st[]++ THEN
  443.             n AND MASK OR curglob ELSE 0
  444.         ELSE
  445.           st:=np
  446.           rewritelist(sl.rptr)
  447.           itab[i].len:=np-st
  448.           itab[i].start:=st
  449.           itab[i].isym:=sl
  450.         ENDIF
  451.       ELSE
  452.         rewritelist(sl.rptr)
  453.       ENDIF
  454.     CASE OPTION
  455.       IF Rnd(1001)<rsym.index THEN rewritelist(rsym.info)
  456.     CASE OPTSET
  457.       rnd:=Rnd(rsym.index)
  458.       c1:=c2:=0
  459.       ol:=rsym.info
  460.       WHILE ol
  461.         c2:=c1+ol.weight
  462.         IF (rnd>=c1) AND (rnd<c2) THEN rewritelist(ol.rptr)
  463.         c1:=c2
  464.         ol:=ol.next
  465.       ENDWHILE
  466.     CASE NOTE
  467.       np[]++:=cursfx OR curglob OR Shl(timings[rsym.info+-MINNOTE],16)
  468.       IF rsym.index>1 THEN FOR x:=2 TO rsym.index DO np[]++:=0
  469.       IF np>=end THEN Raise(LARGESONG)
  470.       cursfx:=0
  471.     CASE SAMPLE
  472.       cursample:=rsym.info
  473.       curglob:=Shl(cursample+1 AND $F,12) OR Shl(cursample+1 AND $F0,24)
  474.     CASE SFX
  475.       cursfx:=rsym.info
  476.   ENDSELECT
  477. ENDPROC
  478.  
  479. PROC loadsamples() HANDLE
  480.   DEF s:PTR TO sample,i,l,r,f:PTR TO LONG
  481.   s:=sdata
  482.   FOR i:=1 TO numsample
  483.     IF (l:=FileLength(s.path))<10 THEN Raise(0)
  484.     s.len:=l
  485.     s.adr:=New(l)
  486.     IF (fh:=Open(s.path,OLDFILE))=NIL THEN Raise(0)
  487.     r:=Read(fh,s.adr,l)
  488.     Close(fh)
  489.     fh:=NIL
  490.     IF r<10 THEN Raise(0)
  491.     f:=s.adr
  492.     IF f[]="FORM"
  493.       WHILE f[]++<>"BODY" DO IF s.adr+l<f THEN Raise(0)
  494.       s.len:=l+s.adr-f
  495.       s.adr:=f
  496.     ENDIF
  497.     s++
  498.   ENDFOR
  499. EXCEPT
  500.   WriteF('En travaillant le sample "\s":\n',s.path)
  501.   Raise(READSAMPLE)
  502. ENDPROC
  503.  
  504. PROC writemodule()
  505.   DEF s,x,pnum,dat[4]:ARRAY OF LONG,nument,n,ch:PTR TO LONG,len,wl
  506.   IF (fh:=Open(outfile,NEWFILE))=NIL THEN Raise(WRITEMOD)
  507.   Write(fh,StringF(s:=String(19),'\l\s[20]',arg) BUT s,20)
  508.   FOR x:=0 TO MAXSAMPLE-1
  509.     wl:=Shr(sdata[x].len,1)
  510.     IF x>=numsample
  511.       Write(fh,[0,0,0,0,0,0,0,0],30)
  512.     ELSE
  513.       Write(fh,sdata[x].path,21)
  514.       Out(fh,0)
  515.       Write(fh,[wl,sdata[x].vol,0,1]:INT,8)  /* or [,,wl,] */
  516.     ENDIF
  517.   ENDFOR
  518.   IF (pnum:=maxrows/256)*256<>maxrows THEN INC pnum
  519.   Out(fh,pnum)
  520.   Out(fh,120)  /* 127 */
  521.   FOR x:=0 TO pnum-1 DO Out(fh,x)
  522.   FOR x:=pnum TO 127 DO Out(fh,0)
  523.   Write(fh,["M.K."],4)
  524.   nument:=pnum*64-1
  525.   FOR x:=0 TO nument
  526.     FOR n:=0 TO 3
  527.       ch:=channel[n].start
  528.       IF ch
  529.         len:=channel[n].len
  530.         IF len
  531.           dat[n]:=ch[]++
  532.           channel[n].start:=ch
  533.           channel[n].len:=len-4
  534.         ELSE
  535.           dat[n]:=0
  536.         ENDIF
  537.       ELSE
  538.         dat[n]:=0
  539.       ENDIF
  540.     ENDFOR
  541.     Write(fh,dat,16)
  542.   ENDFOR
  543.   FOR x:=0 TO numsample-1
  544.     Write(fh,sdata[x].adr,sdata[x].len)
  545.   ENDFOR
  546.   Close(fh)
  547.   fh:=NIL
  548. ENDPROC
  549.